

; Game Manager Class
; handles menus, adding players and creation of the world


(load "globals.scm") ; for *graphics-folder* etc
(load "world.scm")
(load "player.scm")
(load "random-event.scm")
(load "health.scm")
(load "utility.scm") ; for clamp





(define game-manager%
  (class object%
    
    ; PRIVATE VARIABLES
    ;   general
    (define quit #f)
    (define state #f)
    (define background (make-object bitmap% (string-append *graphics-folder* "background" *resource-file-extension*)))
    (define set-controll #f)
    (define world #f)
    ;   main position defines
    (define main-menu-start      0)
    (define main-menu-map        1)
    (define main-menu-player-num 2)
    (define main-menu-controls   3)
    (define main-menu-left       4)
    (define main-menu-right      5)
    (define main-menu-up         6)
    (define main-menu-down       7)
    (define main-menu-shoot      8)
    (define main-menu-jump       9)
    (define main-menu-change     10)
    (define main-menu-help       11)
    (define main-menu-quit       12)
    (define main-menu-last (add1 main-menu-quit))
    (define main-menu-controls-first main-menu-left)
    (define main-menu-controls-last  main-menu-change)
    ;   pause position defines
    (define pause-resume    0)
    (define pause-main-menu 1)
    (define pause-last (add1 pause-main-menu))
    ;   help position defines
    (define help-main-menu 0)
    (define help-last (add1 help-main-menu))
    ;   game-over position defines
    (define game-over-main-menu 0)
    (define game-over-restart   1)
    (define game-over-quit      2)
    (define game-over-last (add1 game-over-quit))
    ;   general pos vars
    (define pos-current #f)
    (define pos-last    #f)
    ;   map vars
    (define map-list   '())
    (define map-current 0)
    ;   player vars
    (define player-list   '())
    (define player-current 0)
    
    
    ; GETTERS
    ; Get Width
    (define/public (get-width)
      (send (if (eq? state 'start) world background) get-width))
    ; Get Height
    (define/public (get-height)
      (send (if (eq? state 'start) world background) get-height))
    
    
    
    
    
    ; Quit?
    (define/public (quit?)
      quit)
    
    
    
    
    
    
 
    ; Get Maps
    ; sets maps to a list of available maps (scans *maps-folder* and filters out collision, background and extension)
    (define (get-maps)
      (set! map-list '())
      (for-each (lambda (file)
                  (let* ([filestring (path->string file)]
                         [extension (substring filestring (- (string-length filestring) (string-length *resource-file-extension*)))]
                         [map (substring filestring 0 (- (string-length filestring) (string-length extension)))])
                    (unless (or (not (equal? extension *resource-file-extension*))
                                (equal? *maps-collision-extension*
                                        (substring map (max 0 (- (string-length map) (string-length *maps-collision-extension*)))))
                                (equal? *maps-background-extension*
                                        (substring map (max 0 (- (string-length map) (string-length *maps-background-extension*))))))
                      (set! map-list (cons map map-list)))))
                (directory-list *maps-folder*)))
    
    
    
    

    ; Start
    (define (start)
      (unless (eq? state 'pause)
        ; create world
        (set! world (new world%))
        (set! *world* world)
        ; load map
        (send world load-map (list-ref map-list (- (sub1 (length map-list)) map-current)))
        ; create heal spawner
        (send *world* add-object (new random-event%
                                      [time *health-time*]
                                      [event (lambda ()
                                               (let ([health (new health%)])
                                                 (send health randomize-position)
                                                 (send *world* add-object health)))]))
        ; introduce players to world
        (set! *num-players-left* 0)
        (for-each (lambda (player)
                    (set! *num-players-left* (add1 *num-players-left*))
                    (send player initialize)
                    (send player randomize-position)
                    (send world add-object player))
                  player-list))
      ; enable players
      (enable-players)
      (set! state 'start))
    
    ; Main Menu
    (define (main-menu)
      (set! pos-current 0)
      (set! pos-last main-menu-last)
      (set! state 'main-menu))
    
    ; Help
    (define (help)
      (set! pos-current 0)
      (set! pos-last help-last)
      (set! state 'help))
    
    ; Pause
    (define (pause)
      (set! pos-current 0)
      (set! pos-last pause-last)
      ; disable players
      (disable-players)
      ; set state
      (set! state 'pause))
    
    ; Game Over
    (define (game-over)
      (set! pos-current 0)
      (set! pos-last game-over-last)
      (disable-players)
      (set! state 'game-over))
    
    
    
    
    
    
    ; Add Player
    (define (add-player)
      (let ([player (new player%)])
        ; add player to list
        (set! player-list (cons player player-list))
        ; set player properties
        (cond ((= 1 (length player-list)) (send player set-controller-keys *player1-controls*))
              ((= 2 (length player-list)) (send player set-controller-keys *player2-controls*))
              (else                       (send player set-controller-keys (make-vector *num-player-controls* 'undefined))))
        (send player set-color (random 256) (random 256) (random 256))
        (send player apply-color)))
    
    ; Remove Player
    (define (remove-player)
      (unless (null? player-list)
        (set! player-list (cdr player-list)))
      (set! player-current (clamp 0 (sub1 (length player-list)) player-current)))
    
    
    ; Enable Players
    (define (enable-players)
      (for-each (lambda (player) (send *user-interface* add-controller player)) player-list))
    
    ; Disable Players
    (define (disable-players)
      ; remove players from list of controllers
      (for-each (lambda (player) (send *user-interface* remove-controller player)) player-list))
    
    
    
    
    
    ; Update
    (define/public (update)
      (when (eq? state 'start)
        (unless (send world update)
          (game-over))))
    
    
    
    
    
    ; Draw
    (define/public (draw dc)
      ; set text drawing help vars
      (let ([width  (send background get-width )]
            [height (send background get-height)]
            [size   0])
        ; always
        ;   setup for text
        (send dc set-text-foreground (send the-color-database find-color "Black"))
        ;   background if not started
        (unless (eq? state 'start)
          (send dc draw-bitmap background 0 0))
        (cond
          ; start
          ((eq? state 'start)
           (set! *player-stats-pos* 0)
           (send world draw dc))
           ; main-menu
          ((eq? state 'main-menu)
           ; menu
           (set! size (truncate (/ width 55)))
           (send dc set-font (make-object font% size 'modern 'normal 'bold))
           (for ([pos (in-range main-menu-last)])
             (let* ([line ""]
                    [controll (vector-ref (send (list-ref player-list (- (sub1 (length player-list)) player-current)) get-controller-keys)
                                          (clamp 0 (sub1 *num-player-controls*) (- pos main-menu-controls-first)))]
                    [conroll-string ((if (symbol? controll) symbol->string string) controll)])
               (set! line (string-append line (if (= pos pos-current) (if set-controll "*" ">") " ") " "))
               (set! line (string-append
                           line
                           (cond ((eq? pos main-menu-start     ) (string-append "Start!"))
                                 ((eq? pos main-menu-map       ) (string-append "Map:                "
                                                                                (if (null? map-list)
                                                                                    ""
                                                                                    (list-ref map-list (- (sub1 (length map-list)) map-current)))))
                                 ((eq? pos main-menu-player-num) (string-append "Number of players:  " (number->string (length player-list))))
                                 ((eq? pos main-menu-controls  ) (string-append "Edit player number: " (number->string (add1 player-current))))
                                 ((eq? pos main-menu-left      ) (string-append "  Left:   " conroll-string))
                                 ((eq? pos main-menu-right     ) (string-append "  Right:  " conroll-string))
                                 ((eq? pos main-menu-up        ) (string-append "  Up:     " conroll-string))
                                 ((eq? pos main-menu-down      ) (string-append "  Down:   " conroll-string))
                                 ((eq? pos main-menu-shoot     ) (string-append "  Shoot:  " conroll-string))
                                 ((eq? pos main-menu-jump      ) (string-append "  Jump:   " conroll-string))
                                 ((eq? pos main-menu-change    ) (string-append "  Change: " conroll-string))
                                 ((eq? pos main-menu-help      ) (string-append "Help"))
                                 ((eq? pos main-menu-quit      ) (string-append "Quit")))))
               (send dc draw-text line (* width 25/100) (+ (* height 40/100) (* pos (* size 3/2)))))))
          ; help
          ((eq? state 'help)
           ; "help-text"
           (set! size (truncate (/ width 55)))
           (send dc set-font (make-object font% size 'modern 'normal 'bold))
           (for ([i (in-range (vector-length *help-text*))])
             (send dc draw-text (vector-ref *help-text* i) (* width 5/100) (+ (* height 40/100) (* i (* size 3/2)))))
           ; menu
           (set! size (truncate (/ width 30)))
           (send dc set-font (make-object font% size 'modern 'normal 'bold))
           (for ([pos (in-range help-last)])
             (let ([line ""])
               (set! line (string-append line (if (= pos pos-current) "> " "  ")))
               (set! line (string-append
                           line
                           (cond ((eq? pos help-main-menu) "Main Menu"))))
               (send dc draw-text line (* width 33/100) (+ (* height 85/100) (* pos (* size 3/2)))))))
          ; pause
          ((eq? state 'pause)
           ; "paused"
           (set! size (truncate (* width 1/8)))
           (send dc set-font (make-object font% size 'modern 'normal 'bold))
           (send dc draw-text "PAUSED" (* width 25/100) (* height 50/100))
           ; menu
           (set! size (truncate (* width 1/30)))
           (send dc set-font (make-object font% size 'modern 'normal 'bold))
           (for ([pos (in-range pause-last)])
             (let ([line ""])
               (set! line (string-append line (if (= pos pos-current) "> " "  ")))
               (set! line (string-append
                           line
                           (cond ((eq? pos pause-resume)    "Resume")
                                 ((eq? pos pause-main-menu) "Main Menu"))))
               (send dc draw-text line (* width 33/100) (+ (* height 80/100) (* pos (* size 3/2)))))))
          ; game-over
          ((eq? state 'game-over)
           (send dc draw-bitmap background 0 0)
           ; winner
           (set! size (truncate (/ width 15)))
           (send dc set-font (make-object font% size 'modern 'normal 'bold))
           (let ([winner #f])
             (for-each (lambda (player)
                         (when (> (send player get-lives) 0)
                           (set! winner player)))
                       player-list)
             (send dc set-brush (make-object color% (send winner get-red) (send winner get-green) (send winner get-blue)) 'solid)
             (send dc set-pen "black" 1 'solid)
             (send dc draw-rectangle (* width 30/100) (* height 45/100) (* width 10/100) (* width 10/100))
             (send dc draw-text "WINNS!" (* width 45/100) (* height 45/100)))
           ; menu
           (set! size (truncate (/ width 30)))
           (send dc set-font (make-object font% size 'modern 'normal 'bold))
           (for ([pos (in-range game-over-last)])
             (let ([line ""])
               (set! line (string-append line (if (= pos pos-current) "> " "  ")))
               (set! line (string-append
                           line
                           (cond ((eq? pos game-over-restart)   "Restart")
                                 ((eq? pos game-over-main-menu) "Main Menu")
                                 ((eq? pos game-over-quit)      "Quit"))))
               (send dc draw-text line (* width 33/100) (+ (* height 70/100) (* pos (* size 3/2))))))))
        ; debugging
        (when *debug* (debug dc (string-append "fps: " (if (= 0 *time-delta*) "?????" (real->decimal-string (/ 1 *time-delta*))))))))
  
  
    
    
    
    
    
    
    
    ; Controller Input
    (define/public (controller-input key pressed)
      (when pressed
        (if set-controll
            ; set controll
            (begin (set! set-controll #f)
                   (vector-set! (send (list-ref player-list (- (sub1 (length player-list)) player-current)) get-controller-keys)
                                (- pos-current main-menu-controls-first)
                                key))
            ; not set controll
            (begin
              ;   debug
              (when (eq? 'f1 key)
                (set! *debug* (not *debug*)))
              ; always
              ;   secret
              (when (eq? 'f8 key)
                (set! *gravity* #i0))
              ;   up/down
              (unless (eq? state 'start)
                (cond ((eq? key 'up)     (set! pos-current (sub1 pos-current)))
                      ((eq? key 'down)   (set! pos-current (add1 pos-current)))
                      ((eq? key 'escape) (set! pos-current (sub1 pos-last))))
                (set! pos-current (rotate-in-range pos-last pos-current)))
              ; not set controll
              (cond
                ; start
                ((eq? state 'start)
                 ; escape
                 (when (eq? key 'escape) (pause)))
                ; main-menu
                ((eq? state 'main-menu)
                 (cond
                   ; escape
                   ((eq? key 'escape) (set! pos-current main-menu-quit))
                   ; enter
                   ((eq? key #\return)
                    (cond ((eq? pos-current main-menu-start) (start))
                          ((eq? pos-current main-menu-help ) (help))
                          ((eq? pos-current main-menu-quit ) (set! quit #t))
                          ((and (<= main-menu-controls-first pos-current) (<= pos-current main-menu-controls-last)) (set! set-controll #t))
                          (else (controller-input 'right pressed))))
                   ; left
                   ((eq? key 'left)
                    (cond ((eq? pos-current main-menu-map)        (set! map-current    (rotate-in-range (length map-list)    (sub1 map-current))))
                          ((eq? pos-current main-menu-controls)   (set! player-current (rotate-in-range (length player-list) (sub1 player-current))))
                          ((eq? pos-current main-menu-player-num) (when (> (length player-list) 1) (remove-player)))))
                   ; right
                   ((eq? key 'right)
                    (cond ((eq? pos-current main-menu-map)        (set! map-current    (rotate-in-range (length map-list)    (add1 map-current))))
                          ((eq? pos-current main-menu-controls)   (set! player-current (rotate-in-range (length player-list) (add1 player-current))))
                          ((eq? pos-current main-menu-player-num) (add-player))))))
                ; help
                ((eq? state 'help)
                 (cond
                   ; enter
                   ((eq? key #\return)
                    (cond ((eq? pos-current help-main-menu) (main-menu) (set! pos-current main-menu-help))))))
                ; pause
                ((eq? state 'pause)
                 (cond
                   ; escape
                   ((eq? key 'escape)
                    (start))
                   ; enter
                   ((eq? key #\return)
                    (cond ((eq? pos-current pause-resume)    (start))
                          ((eq? pos-current pause-main-menu) (main-menu))))))
                ; game-over
                ((eq? state 'game-over)
                 (cond
                   ; enter
                   ((eq? key #\return)
                    (cond ((eq? pos-current game-over-main-menu) (main-menu))
                          ((eq? pos-current game-over-restart)   (start))
                          ((eq? pos-current game-over-quit)      (set! quit #t)))))))))))
    
    
      
      ; Constructor/Initialization
    (super-new)
    (get-maps)
    (add-player)
    (add-player)
    (main-menu)))




